#Setup

#install.packages("tidyverse")
#install.packages("PerformanceAnalytics")
#install.packages("ggfortify")
#install.packages("fastDummies")

library(tidyverse) # core package includes following packages: tidyr, dplyr, ggplot2, readr, purrr, tibble, stringr, forcats
Warnung: vorhergehender Import ‘lifecycle::last_warnings’ durch ‘rlang::last_warnings’ während des Ladens von ‘pillar’ ersetztWarnung: vorhergehender Import ‘lifecycle::last_warnings’ durch ‘rlang::last_warnings’ während des Ladens von ‘tibble’ ersetztRegistered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
Warnung: vorhergehender Import ‘lifecycle::last_warnings’ durch ‘rlang::last_warnings’ während des Ladens von ‘hms’ ersetzt-- Attaching packages ----------------------------------------------------------------------- tidyverse 1.3.1 --
v ggplot2 3.3.5     v purrr   0.3.4
v tibble  3.1.4     v dplyr   1.0.7
v tidyr   1.1.3     v stringr 1.4.0
v readr   2.0.1     v forcats 0.5.1
-- Conflicts -------------------------------------------------------------------------- tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
library(plotly)
Warnung: Paket ‘plotly’ wurde unter R Version 4.1.3 erstelltRegistered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attache Paket: ‘plotly’

Das folgende Objekt ist maskiert ‘package:ggplot2’:

    last_plot

Das folgende Objekt ist maskiert ‘package:stats’:

    filter

Das folgende Objekt ist maskiert ‘package:graphics’:

    layout
library("PerformanceAnalytics") #for correlation
Warnung: Paket ‘PerformanceAnalytics’ wurde unter R Version 4.1.3 erstelltLade nötiges Paket: xts
Warnung: Paket ‘xts’ wurde unter R Version 4.1.3 erstelltLade nötiges Paket: zoo
Warnung: Paket ‘zoo’ wurde unter R Version 4.1.3 erstellt
Attache Paket: ‘zoo’

Die folgenden Objekte sind maskiert von ‘package:base’:

    as.Date, as.Date.numeric


Attache Paket: ‘xts’

Die folgenden Objekte sind maskiert von ‘package:dplyr’:

    first, last


Attache Paket: ‘PerformanceAnalytics’

Das folgende Objekt ist maskiert ‘package:graphics’:

    legend
library(broom) # for model quantification
library(ggfortify) # for visualizing model fits
Warnung: Paket ‘ggfortify’ wurde unter R Version 4.1.3 erstellt
library(fastDummies)
Warnung: Paket ‘fastDummies’ wurde unter R Version 4.1.3 erstellt
library(dplyr)
library(ggplot2)
bike_data <- read_csv("SeoulBikeData.csv",
  show_col_types = FALSE,
  col_types = cols(Date = col_date(format = "%d/%m/%Y"),
    Seasons = col_factor(levels = c("Winter", "Spring", "Summer", "Autumn"),
                         ordered = TRUE),
    Holiday = col_factor(),
    "Functioning Day" = col_factor()
  ))
bike_data <- bike_data %>%
  mutate(day = weekdays(Date), 
         month = months(Date),
         day_time = case_when(
           Hour >= 5 & Hour < 11 ~ "Morning",
           Hour >= 11 & Hour < 15 ~ "Noon",
           Hour >= 15 & Hour < 18 ~ "Afternoon",
           Hour >= 18 & Hour < 22 ~ "Evening",
           Hour < 5 | Hour >= 22 ~ "Night")) %>%
  select(Date,month,day,Hour,day_time, Holiday, 'Rented Bike Count',everything())
bike_data$day_time <- factor(bike_data$day_time,
                             levels = c("Morning", "Noon", "Afternoon", "Evening", "Night"),ordered = TRUE)

bike_data$day <- factor(bike_data$day, 
                        levels = c("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag" ))

bike_data$month <- factor(bike_data$month, 
                          levels = c("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober","November", "Dezember"))

#LO1: Performance

grafik_1 <- bike_data %>%
  plot_ly(x = ~Seasons) %>%
    add_histogram(color = I("darkgreen"), opacity = 0.9) %>%
  layout(title = "Total bike count by seasons")
start <- Sys.time()
grafik_1
end <- Sys.time()
print(end - start)
Time difference of 0.473356 secs
grafik_4 <- ggplot(bike_data, aes(`Temperature` ,`Rented Bike Count`, color = `Seasons`))+
  geom_jitter(alpha = 0.3)+
  scale_fill_grey(start = 0.2, end = 0.8,na.value = "red")+
  stat_smooth(method = lm, se = FALSE, color = "red")+
  labs(
    x = "Temperature in Celsius",
    y = "Rented Bikes",
    title = "Correlation between temperature and rented bikes")+
  theme_minimal()
start <- Sys.time()
grafik_4

end <- Sys.time()
print(end - start)
Time difference of 1.329525 secs

#LO2: Dashboard design principes

Grafik 3:

bike_data %>%
  plot_ly(x = ~Seasons) %>%
    add_histogram(color = I("navy"), opacity = 0.9) %>%
  layout(title = "Total bike count by seasons")

##Grafik 4:

grafik_4 <- ggplot(bike_data, aes(`Temperature` ,`Rented Bike Count`, color = `Seasons`))+
  geom_jitter(alpha = 0.3)+
  scale_fill_grey(start = 0.2, end = 0.8,na.value = "red")+
  stat_smooth(method = lm, se = FALSE, color = "red")+
  labs(
    x = "Temperature in Celsius",
    y = "Rented Bikes",
    title = "Correlation between temperature and rented bikes")+
  theme_minimal()
ggplotly(grafik_4)
`geom_smooth()` using formula 'y ~ x'

##Grafik 5

scatter <- ggplot(bike_data,aes(x= Snowfall, y = `Rented Bike Count`))+
  geom_jitter(shape=8, (aes(color = Temperature)))+
  scale_color_gradient(low="dark blue", high= "light blue")+
  facet_wrap(~month)+
  ggtitle("Bike rental and the impact of snow")+
  theme_minimal()
ggplotly(scatter)
grafik_4 <- plot_ly() %>%
  add_trace(bike, x = ~'Hour', y = ~bike_data$'Rented Bike Count', type = 'scatter', mode = 'lines+markers', name = 'Name of Trace 1') %>%
  layout(title = 'Plot Title')

grafik_4

#LO3: #LO4: Evaluation

LS0tDQp0aXRsZTogIklWSSBOb3RlYm9vayINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQojU2V0dXANCmBgYHtyfQ0KI2luc3RhbGwucGFja2FnZXMoInRpZHl2ZXJzZSIpDQojaW5zdGFsbC5wYWNrYWdlcygiUGVyZm9ybWFuY2VBbmFseXRpY3MiKQ0KI2luc3RhbGwucGFja2FnZXMoImdnZm9ydGlmeSIpDQojaW5zdGFsbC5wYWNrYWdlcygiZmFzdER1bW1pZXMiKQ0KDQpsaWJyYXJ5KHRpZHl2ZXJzZSkgIyBjb3JlIHBhY2thZ2UgaW5jbHVkZXMgZm9sbG93aW5nIHBhY2thZ2VzOiB0aWR5ciwgZHBseXIsIGdncGxvdDIsIHJlYWRyLCBwdXJyciwgdGliYmxlLCBzdHJpbmdyLCBmb3JjYXRzDQpsaWJyYXJ5KHBsb3RseSkNCmxpYnJhcnkoIlBlcmZvcm1hbmNlQW5hbHl0aWNzIikgI2ZvciBjb3JyZWxhdGlvbg0KbGlicmFyeShicm9vbSkgIyBmb3IgbW9kZWwgcXVhbnRpZmljYXRpb24NCmxpYnJhcnkoZ2dmb3J0aWZ5KSAjIGZvciB2aXN1YWxpemluZyBtb2RlbCBmaXRzDQpsaWJyYXJ5KGZhc3REdW1taWVzKQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkoZ2dwbG90MikNCmBgYA0KDQpgYGB7cn0NCmJpa2VfZGF0YSA8LSByZWFkX2NzdigiU2VvdWxCaWtlRGF0YS5jc3YiLA0KICBzaG93X2NvbF90eXBlcyA9IEZBTFNFLA0KICBjb2xfdHlwZXMgPSBjb2xzKERhdGUgPSBjb2xfZGF0ZShmb3JtYXQgPSAiJWQvJW0vJVkiKSwNCiAgICBTZWFzb25zID0gY29sX2ZhY3RvcihsZXZlbHMgPSBjKCJXaW50ZXIiLCAiU3ByaW5nIiwgIlN1bW1lciIsICJBdXR1bW4iKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICBvcmRlcmVkID0gVFJVRSksDQogICAgSG9saWRheSA9IGNvbF9mYWN0b3IoKSwNCiAgICAiRnVuY3Rpb25pbmcgRGF5IiA9IGNvbF9mYWN0b3IoKQ0KICApKQ0KYGBgDQoNCmBgYHtyfQ0KYmlrZV9kYXRhIDwtIGJpa2VfZGF0YSAlPiUNCiAgbXV0YXRlKGRheSA9IHdlZWtkYXlzKERhdGUpLCANCiAgICAgICAgIG1vbnRoID0gbW9udGhzKERhdGUpLA0KICAgICAgICAgZGF5X3RpbWUgPSBjYXNlX3doZW4oDQogICAgICAgICAgIEhvdXIgPj0gNSAmIEhvdXIgPCAxMSB+ICJNb3JuaW5nIiwNCiAgICAgICAgICAgSG91ciA+PSAxMSAmIEhvdXIgPCAxNSB+ICJOb29uIiwNCiAgICAgICAgICAgSG91ciA+PSAxNSAmIEhvdXIgPCAxOCB+ICJBZnRlcm5vb24iLA0KICAgICAgICAgICBIb3VyID49IDE4ICYgSG91ciA8IDIyIH4gIkV2ZW5pbmciLA0KICAgICAgICAgICBIb3VyIDwgNSB8IEhvdXIgPj0gMjIgfiAiTmlnaHQiKSkgJT4lDQogIHNlbGVjdChEYXRlLG1vbnRoLGRheSxIb3VyLGRheV90aW1lLCBIb2xpZGF5LCAnUmVudGVkIEJpa2UgQ291bnQnLGV2ZXJ5dGhpbmcoKSkNCmBgYA0KDQpgYGB7cn0NCmJpa2VfZGF0YSRkYXlfdGltZSA8LSBmYWN0b3IoYmlrZV9kYXRhJGRheV90aW1lLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsZXZlbHMgPSBjKCJNb3JuaW5nIiwgIk5vb24iLCAiQWZ0ZXJub29uIiwgIkV2ZW5pbmciLCAiTmlnaHQiKSxvcmRlcmVkID0gVFJVRSkNCg0KYmlrZV9kYXRhJGRheSA8LSBmYWN0b3IoYmlrZV9kYXRhJGRheSwgDQogICAgICAgICAgICAgICAgICAgICAgICBsZXZlbHMgPSBjKCJNb250YWciLCAiRGllbnN0YWciLCAiTWl0dHdvY2giLCAiRG9ubmVyc3RhZyIsICJGcmVpdGFnIiwgIlNhbXN0YWciLCAiU29ubnRhZyIgKSkNCg0KYmlrZV9kYXRhJG1vbnRoIDwtIGZhY3RvcihiaWtlX2RhdGEkbW9udGgsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICBsZXZlbHMgPSBjKCJKYW51YXIiLCAiRmVicnVhciIsICJNw6RyeiIsICJBcHJpbCIsICJNYWkiLCAiSnVuaSIsICJKdWxpIiwgIkF1Z3VzdCIsICJTZXB0ZW1iZXIiLCAiT2t0b2JlciIsIk5vdmVtYmVyIiwgIkRlemVtYmVyIikpDQpgYGANCg0KI0xPMTogUGVyZm9ybWFuY2UNCmBgYHtyfQ0KZ3JhZmlrXzEgPC0gYmlrZV9kYXRhICU+JQ0KICBwbG90X2x5KHggPSB+U2Vhc29ucykgJT4lDQoJYWRkX2hpc3RvZ3JhbShjb2xvciA9IEkoImRhcmtncmVlbiIpLCBvcGFjaXR5ID0gMC45KSAlPiUNCiAgbGF5b3V0KHRpdGxlID0gIlRvdGFsIGJpa2UgY291bnQgYnkgc2Vhc29ucyIpDQpgYGANCg0KYGBge3J9DQpzdGFydCA8LSBTeXMudGltZSgpDQpncmFmaWtfMQ0KZW5kIDwtIFN5cy50aW1lKCkNCnByaW50KGVuZCAtIHN0YXJ0KQ0KYGBgDQpgYGB7cn0NCmdyYWZpa180IDwtIGdncGxvdChiaWtlX2RhdGEsIGFlcyhgVGVtcGVyYXR1cmVgICxgUmVudGVkIEJpa2UgQ291bnRgLCBjb2xvciA9IGBTZWFzb25zYCkpKw0KICBnZW9tX2ppdHRlcihhbHBoYSA9IDAuMykrDQogIHNjYWxlX2ZpbGxfZ3JleShzdGFydCA9IDAuMiwgZW5kID0gMC44LG5hLnZhbHVlID0gInJlZCIpKw0KICBzdGF0X3Ntb290aChtZXRob2QgPSBsbSwgc2UgPSBGQUxTRSwgY29sb3IgPSAicmVkIikrDQogIGxhYnMoDQogICAgeCA9ICJUZW1wZXJhdHVyZSBpbiBDZWxzaXVzIiwNCiAgICB5ID0gIlJlbnRlZCBCaWtlcyIsDQogICAgdGl0bGUgPSAiQ29ycmVsYXRpb24gYmV0d2VlbiB0ZW1wZXJhdHVyZSBhbmQgcmVudGVkIGJpa2VzIikrDQogIHRoZW1lX21pbmltYWwoKQ0KYGBgDQoNCmBgYHtyfQ0Kc3RhcnQgPC0gU3lzLnRpbWUoKQ0KZ3JhZmlrXzQNCmVuZCA8LSBTeXMudGltZSgpDQpwcmludChlbmQgLSBzdGFydCkNCmBgYA0KDQojTE8yOiBEYXNoYm9hcmQgZGVzaWduIHByaW5jaXBlcw0KDQojIyBHcmFmaWsgMzogDQpgYGB7cn0NCmJpa2VfZGF0YSAlPiUNCiAgcGxvdF9seSh4ID0gflNlYXNvbnMpICU+JQ0KCWFkZF9oaXN0b2dyYW0oY29sb3IgPSBJKCJuYXZ5IiksIG9wYWNpdHkgPSAwLjkpICU+JQ0KICBsYXlvdXQodGl0bGUgPSAiVG90YWwgYmlrZSBjb3VudCBieSBzZWFzb25zIikNCmBgYA0KDQojI0dyYWZpayA0OiANCmBgYHtyfQ0KZ3JhZmlrXzQgPC0gZ2dwbG90KGJpa2VfZGF0YSwgYWVzKGBUZW1wZXJhdHVyZWAgLGBSZW50ZWQgQmlrZSBDb3VudGAsIGNvbG9yID0gYFNlYXNvbnNgKSkrDQogIGdlb21faml0dGVyKGFscGhhID0gMC4zKSsNCiAgc2NhbGVfZmlsbF9ncmV5KHN0YXJ0ID0gMC4yLCBlbmQgPSAwLjgsbmEudmFsdWUgPSAicmVkIikrDQogIHN0YXRfc21vb3RoKG1ldGhvZCA9IGxtLCBzZSA9IEZBTFNFLCBjb2xvciA9ICJyZWQiKSsNCiAgbGFicygNCiAgICB4ID0gIlRlbXBlcmF0dXJlIGluIENlbHNpdXMiLA0KICAgIHkgPSAiUmVudGVkIEJpa2VzIiwNCiAgICB0aXRsZSA9ICJDb3JyZWxhdGlvbiBiZXR3ZWVuIHRlbXBlcmF0dXJlIGFuZCByZW50ZWQgYmlrZXMiKSsNCiAgdGhlbWVfbWluaW1hbCgpDQpgYGANCg0KYGBge3J9DQpnZ3Bsb3RseShncmFmaWtfNCkNCmBgYA0KIyNHcmFmaWsgNQ0KYGBge3J9DQpzY2F0dGVyIDwtIGdncGxvdChiaWtlX2RhdGEsYWVzKHg9IFNub3dmYWxsLCB5ID0gYFJlbnRlZCBCaWtlIENvdW50YCkpKw0KICBnZW9tX2ppdHRlcihzaGFwZT04LCAoYWVzKGNvbG9yID0gVGVtcGVyYXR1cmUpKSkrDQogIHNjYWxlX2NvbG9yX2dyYWRpZW50KGxvdz0iZGFyayBibHVlIiwgaGlnaD0gImxpZ2h0IGJsdWUiKSsNCiAgZmFjZXRfd3JhcCh+bW9udGgpKw0KICBnZ3RpdGxlKCJCaWtlIHJlbnRhbCBhbmQgdGhlIGltcGFjdCBvZiBzbm93IikrDQogIHRoZW1lX21pbmltYWwoKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90bHkoc2NhdHRlcikNCmBgYA0KDQoNCmBgYHtyfQ0KZ3JhZmlrXzQgPC0gcGxvdF9seSgpICU+JQ0KICBhZGRfdHJhY2UoYmlrZSwgeCA9IH4nSG91cicsIHkgPSB+YmlrZV9kYXRhJCdSZW50ZWQgQmlrZSBDb3VudCcsIHR5cGUgPSAnc2NhdHRlcicsIG1vZGUgPSAnbGluZXMrbWFya2VycycsIG5hbWUgPSAnTmFtZSBvZiBUcmFjZSAxJykgJT4lDQogIGxheW91dCh0aXRsZSA9ICdQbG90IFRpdGxlJykNCg0KZ3JhZmlrXzQNCmBgYA0KDQojTE8zOg0KI0xPNDogRXZhbHVhdGlvbg0K